New Star Software Collection/NSS_Collection.iso/3-004 ms visual basic pro 30/4.imz/4.IMA/SQL.FR_/SQL.bin

Text File | 1993-04-28 | 5KB | 206 lines

VERSION 2.00
Begin Form fSQL
   BackColor       =   &H00C0C0C0&
   Caption         =   "SQL Statement"
   ClientHeight    =   2880
   ClientLeft      =   3690
   ClientTop       =   1575
   ClientWidth     =   5250
   Height          =   3285
   Icon            =   SQL.FRX:0000
   Left            =   3630
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   ScaleHeight     =   2863.353
   ScaleMode       =   0  'User
   ScaleWidth      =   5268
   Top             =   1230
   Width           =   5370
   Begin CheckBox cPassThru
      BackColor       =   &H00C0C0C0&
      Caption         =   "&SQL PassThrough"
      Height          =   225
      Left            =   210
      TabIndex        =   4
      Top             =   553
      Width           =   2640
   End
   Begin CommandButton CreateQueryDefbtn
      Caption         =   "Create &QueryDef"
      Height          =   375
      Left            =   3045
      TabIndex        =   3
      Top             =   121
      Visible         =   0   'False
      Width           =   1695
   End
   Begin CommandButton ExecuteSQLButton
      Caption         =   "&Execute SQL"
      Default         =   -1  'True
      Enabled         =   0   'False
      Height          =   372
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   1332
   End
   Begin CommandButton ClearSQLButton
      Caption         =   "&Clear SQL"
      Height          =   372
      Left            =   1560
      TabIndex        =   1
      Top             =   120
      Width           =   1332
   End
   Begin TextBox cSQLStatement
      BackColor       =   &H00FFFFFF&
      Height          =   1932
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   0
      Tag             =   "OL"
      Top             =   840
      Width           =   5052
   End
End
Option Explicit

Sub ClearSQLButton_Click ()
  cSQLStatement = ""
  cSQLStatement.SetFocus
End Sub

Sub CreateQueryDefbtn_Click ()
  Dim qn As String
  Dim q As querydef

  On Error GoTo CQDErr

  qn = InputBox("Enter QueryDef Name:")
  If qn = "" Then Exit Sub

  Set q = gCurrentDB.CreateQueryDef(qn, cSQLStatement)
  RefreshTables fTables.cTableList, True

  GoTo CQDEnd

CQDErr:
  ShowError
  Resume CQDEnd

CQDEnd:

End Sub

Sub cSQLStatement_Change ()
  If cSQLStatement <> "" Then
    ExecuteSQLButton.Enabled = True
  Else
    ExecuteSQLButton.Enabled = False
  End If
End Sub

Sub ExecuteSQLButton_Click ()
   Dim RetSQL As Long

   If cSQLStatement = "" Then Exit Sub

   MsgBar "Executing SQL Statement", True
   SetHourglass Me
   If UCase(Mid(cSQLStatement, 1, 6)) = "SELECT" And InStr(UCase(cSQLStatement), " INTO ") = 0 Then
     On Error GoTo SQLDSErr
MakeDynaset:
     gfFromSQL = True
     'create a new dynaset form
     gstDynaString = ""
     On Error GoTo SQLDSErr
     If VDMDI.cSingleRecord = True Then
       Dim dsform1 As New fDynaset
       dsform1.Show
     ElseIf VDMDI.cDataCtl = True Then
       Dim dsform2 As New fDataForm
       dsform2.Show
     Else
       Dim dsform3 As New fGridFrm
       dsform3.Show
     End If
   ElseIf UCase(cSQLStatement) = "LISTTABLES" Then
     GoTo MakeDynaset
   Else
     On Error GoTo SQLErr
     If gstDataType = "ODBC" Then
       If UCase(Mid(cSQLStatement, 1, 4)) = "USE " Then
         Beep
         MsgBox "'Use' not allowed, try Open DataBase.", 48
         GoTo SQLEnd
       End If
       RetSQL = gCurrentDB.ExecuteSQL(cSQLStatement)
       If RetSQL > 0 Then
         If gfTransPending Then gfDBChanged = True
       End If
       MsgBox CStr(RetSQL) + " row(s) Affected by SQL Statement.", 48
     Else
       gCurrentDB.Execute (cSQLStatement)
       MsgBox "Execute of SQL Statement was Successful.", 48
     End If

   End If

   GoTo SQLEnd

SQLErr:
   If Err = 3065 Then   'row returning so try to create dynaset
     Resume MakeDynaset
   End If
   ShowError
   Resume SQLEnd

SQLDSErr:
   Resume SQLEnd

SQLEnd:
   ResetMouse Me
   MsgBar "", False

End Sub

Sub Form_Load ()
  Dim x As Integer

  cSQLStatement = GetINIString("SQLStatement", "")

  x = Val(GetINIString("SQLWindowHeight", "3000"))
  Height = x
  x = Val(GetINIString("SQLWindowWidth", "5370"))
  Width = x
  x = Val(GetINIString("SQLWindowTop", "0"))
  Top = x
  x = Val(GetINIString("SQLWindowLeft", CStr(fTables.Left + fTables.Width)))
  Left = x

End Sub

Sub Form_Paint ()
  Outlines Me
End Sub

Sub Form_Resize ()
  On Error Resume Next

  If WindowState <> 1 Then
    cSQLStatement.Width = Width - 320
    cSQLStatement.Height = Height - 1450
    Outlines Me
    Me.Refresh
  End If
End Sub

Sub Form_Unload (Cancel As Integer)
  Dim x As Integer

  Me.WindowState = 1
  Cancel = True
End Sub